home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / auto-l1a / idbas_sy.bas < prev    next >
BASIC Source File  |  1999-03-30  |  4KB  |  138 lines
  1. Attribute VB_Name = "IDBAS_SystemInformation"
  2. Option Explicit
  3.  
  4.  Type SYSTEM_INFO
  5.      dwOemID As Long
  6.      dwPageSize As Long
  7.      lpMinimumApplicationAddress As Long
  8.      lpMaximumApplicationAddress As Long
  9.      dwActiveProcessorMask As Long
  10.      dwNumberOrfProcessors As Long
  11.      dwProcessorType As Long
  12.      dwAllocationGranularity As Long
  13.      dwReserved As Long
  14.  End Type
  15.  
  16.  Type OSVERSIONINFO
  17.      dwOSVersionInfoSize As Long
  18.      dwMajorVersion As Long
  19.      dwMinorVersion As Long
  20.      dwBuildNumber As Long
  21.      dwPlatformId As Long
  22.      szCSDVersion As String * 128
  23.  End Type
  24.  
  25.  Type MEMORYSTATUS
  26.      dwLength As Long
  27.      dwMemoryLoad As Long
  28.      dwTotalPhys As Long
  29.      dwAvailPhys As Long
  30.      dwTotalPageFile As Long
  31.      dwAvailPageFile As Long
  32.      dwTotalVirtual As Long
  33.      dwAvailVirtual As Long
  34.  End Type
  35.  
  36.  Enum OsVersion
  37.     Windows32s = 0
  38.     Windows95 = 1
  39.     WindowsNT = 2
  40.  End Enum
  41.  
  42. 'The following three Declare lines must be each entered on a single
  43. 'line.
  44. Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (LpVersionInformation As OSVERSIONINFO) As Long
  45. Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
  46. Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
  47.  
  48. Public Const PROCESSOR_INTEL_386 = 386
  49. Public Const PROCESSOR_INTEL_486 = 486
  50. Public Const PROCESSOR_INTEL_PENTIUM = 586
  51. Public Const PROCESSOR_MIPS_R4000 = 4000
  52. Public Const PROCESSOR_ALPHA_21064 = 21064
  53.  
  54. Dim msg As String         ' Status information.
  55. Dim NewLine As String     ' New-line.
  56. Dim ret As Integer        ' OS Information
  57. Dim ver_major As Integer  ' OS Version
  58. Dim ver_minor As Integer  ' Minor Os Version
  59. Dim Build As Long         ' OS Build
  60. Dim verinfo As OSVERSIONINFO
  61. Dim sysinfo As SYSTEM_INFO
  62. Dim memsts As MEMORYSTATUS
  63. Dim memory As Long
  64. Dim OsType As OsVersion
  65.  
  66.  
  67. Function SystemInformation() As String
  68.  
  69.       NewLine = Chr(13) + Chr(10)  ' New-line.
  70.        ' Get operating system and version.
  71.       verinfo.dwOSVersionInfoSize = Len(verinfo)
  72.       ret = GetVersionEx(verinfo)
  73.       If ret = 0 Then
  74.           MsgBox "Error Getting Version Information"
  75.           End
  76.       End If
  77.  
  78.       Select Case verinfo.dwPlatformId
  79.           Case 0
  80.               msg = msg + "Windows 32s "
  81.               OsType = Windows32s
  82.           Case 1
  83.               msg = msg + "Windows 95 "
  84.               OsType = Windows95
  85.           Case 2
  86.               msg = msg + "Windows NT "
  87.               OsType = WindowsNT
  88.       End Select
  89.  
  90.       ver_major = verinfo.dwMajorVersion
  91.       ver_minor = verinfo.dwMinorVersion
  92.       Build = verinfo.dwBuildNumber
  93.       msg = msg & ver_major & "." & ver_minor
  94.       msg = msg & " (Build " & Build & ")" & NewLine & NewLine
  95.  
  96.       ' Get CPU type and operating mode.
  97.       GetSystemInfo sysinfo
  98.       msg = msg + "CPU: "
  99.       Select Case sysinfo.dwProcessorType
  100.           Case PROCESSOR_INTEL_386
  101.               msg = msg + "Intel 386" + NewLine
  102.           Case PROCESSOR_INTEL_486
  103.               msg = msg + "Intel 486" + NewLine
  104.           Case PROCESSOR_INTEL_PENTIUM
  105.               msg = msg + "Intel Pentium" + NewLine
  106.           Case PROCESSOR_MIPS_R4000
  107.               msg = msg + "MIPS R4000" + NewLine
  108.           Case PROCESSOR_ALPHA_21064
  109.               msg = msg + "DEC Alpha 21064" + NewLine
  110.           Case Else
  111.               msg = msg + "(unknown)" + NewLine
  112.       End Select
  113.  
  114.       msg = msg + NewLine
  115.  
  116.       ' Get free memory.
  117.       GlobalMemoryStatus memsts
  118.       memory = memsts.dwTotalPhys
  119.       msg = msg + "Total Physical Memory: "
  120.       msg = msg + Format(memory \ 1024, "###,###,###") + "K" + NewLine
  121.       memory = memsts.dwAvailPhys
  122.       msg = msg + "Available Physical Memory: "
  123.       msg = msg + Format(memory \ 1024, "###,###,###") + "K" + NewLine
  124.       memory = memsts.dwTotalVirtual
  125.       msg = msg + "Total Virtual Memory: "
  126.       msg = msg + Format(memory \ 1024, "###,###,###") + "K" + NewLine
  127.       memory = memsts.dwAvailVirtual
  128.       msg = msg + "Available Virtual Memory: "
  129.       msg = msg + Format(memory \ 1024, "###,###,###") + "K" + NewLine
  130.  
  131.       SystemInformation = msg
  132. End Function
  133.  
  134. Public Function OperatingSystemVersion() As OsVersion
  135.     Call SystemInformation
  136.     OperatingSystemVersion = OsType
  137. End Function
  138.